home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / docs / tut7new / tut7.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-01-06  |  26.0 KB  |  693 lines
  1. (*****************************************************************************)
  2. (*                                                                           *)
  3. (* TUT7.PAS - VGA Trainer Program 7 (in Pascal)                              *)
  4. (*                                                                           *)
  5. (* "The VGA Trainer Program" is written by Denthor of Asphyxia.  However it  *)
  6. (* was limited to Pascal only in its first run.  All I have done is taken    *)
  7. (* his original release, translated it to C++, and touched up a few things.  *)
  8. (* I take absolutely no credit for the concepts presented in this code, and  *)
  9. (* am NOT the person to ask for help if you are having trouble.  -Snowman    *)
  10. (*                                                                           *)
  11. (* Program Notes : This program demonstrates animation.  Several of the      *)
  12. (*                 functions have been converted to assembler.  This         *)
  13. (*                 tutorial is a whopper, so just take your time.            *)
  14. (*                                                                           *)
  15. (* Author        : Grant Smith (Denthor)  - denthor@beastie.cs.und.ac.za     *)
  16. (*                                                                           *)
  17. (*****************************************************************************)
  18.  
  19. {$X+}
  20. USES crt;
  21.  
  22. CONST VGA = $a000;
  23.  
  24. Type Toastinfo = Record                 { This is format of of each of our }
  25.                  x,y:integer;              { records for the flying toasters }
  26.                  speed,frame:integer;
  27.                  active:boolean;
  28.                END;
  29.  
  30.      icon = Array [1..30*48] of byte;  { This is the size of our pictures }
  31.  
  32.      Virtual = Array [1..64000] of byte;  { The size of our Virtual Screen }
  33.      VirtPtr = ^Virtual;                  { Pointer to the virtual screen }
  34.  
  35. CONST frame1 : icon = (
  36. 0,0,0,0,5,5,5,5,5,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,5,5,5,5,5,5,5,
  37. 7,7,7,7,0,0,0,0,0,0,0,5,5,5,5,5,5,5,5,5,5,5,5,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,5,
  38. 5,7,7,7,7,7,7,7,8,8,7,7,7,7,7,7,0,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,0,0,0,0,0,0,0,0,
  39. 0,0,0,0,0,5,5,7,7,7,7,7,8,8,7,8,8,7,8,7,8,7,7,7,5,8,8,8,8,5,5,5,5,5,5,5,5,5,5,5,
  40. 5,0,0,0,0,0,0,0,0,0,0,0,5,7,7,7,7,7,7,8,7,7,7,8,7,7,7,7,7,7,0,0,0,0,0,0,8,5,5,5,
  41. 5,5,5,5,5,5,5,5,5,0,0,0,0,0,0,0,0,0,0,5,7,7,8,8,7,7,8,7,7,8,7,7,7,7,7,0,0,0,0,0,
  42. 0,0,0,0,0,0,5,5,5,5,5,5,5,5,5,5,5,5,0,0,0,0,0,0,0,0,5,7,8,8,8,7,7,8,7,7,8,7,7,7,
  43. 7,7,0,0,0,0,0,0,0,0,0,0,0,0,0,5,5,5,5,5,5,5,5,5,5,5,5,0,0,0,0,0,0,5,7,8,8,8,7,7,
  44. 8,8,8,8,8,8,7,7,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,9,9,9,9,
  45. 9,5,7,8,8,8,8,8,7,7,8,8,7,7,7,7,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,
  46. 1,1,1,1,9,9,9,9,5,7,7,8,8,8,8,7,7,8,8,7,7,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,
  47. 1,1,0,0,0,1,1,1,1,1,1,1,9,9,9,5,7,8,8,7,7,8,8,7,8,8,8,7,0,0,0,0,0,0,0,0,0,0,0,0,
  48. 0,0,0,0,0,0,1,1,1,1,0,0,0,1,1,1,1,1,1,1,1,1,1,5,7,8,8,7,7,7,7,8,8,7,7,7,0,0,0,0,
  49. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,0,0,0,1,1,1,1,1,1,2,2,2,2,7,8,8,8,8,8,8,8,7,
  50. 7,7,2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,0,0,0,1,1,1,1,1,1,2,2,2,2,7,
  51. 7,7,7,7,7,7,7,7,2,2,2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,0,0,0,1,1,1,
  52. 1,1,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,
  53. 1,1,0,0,0,1,1,1,1,1,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,0,0,0,0,0,0,0,0,0,0,0,0,0,
  54. 0,0,0,0,0,0,1,1,1,1,0,0,0,1,1,1,1,1,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,0,0,0,0,0,
  55. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,0,0,0,1,1,1,1,1,1,2,2,2,2,2,2,2,2,2,2,2,2,2,
  56. 2,2,2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,0,0,0,1,1,1,1,1,1,2,2,2,2,2,
  57. 2,2,2,2,2,2,2,2,2,2,2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,0,0,0,1,1,1,
  58. 1,1,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,4,
  59. 4,6,6,6,6,6,6,1,1,1,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,0,0,0,0,0,0,0,0,0,0,0,0,0,
  60. 0,0,0,0,0,0,1,1,1,1,1,1,1,1,2,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,
  61. 0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,3,3,1,1,1,1,9,9,9,9,9,9,9,9,9,9,9,9,
  62. 9,9,9,9,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,9,9,9,9,
  63. 9,9,9,9,9,9,9,9,9,9,9,9,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,
  64. 1,1,1,1,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  65. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  66. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  67. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  68. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  69. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  70. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  71. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  72. );
  73.       frame2 : icon = (
  74. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  75. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  76. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  77. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  78. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  79. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  80. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  81. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  82. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,9,9,9,9,
  83. 9,9,9,9,9,9,9,9,9,9,9,9,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,
  84. 1,1,1,1,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,
  85. 1,1,0,0,0,1,1,1,1,1,1,1,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,0,0,0,0,0,0,0,0,0,0,0,0,
  86. 0,0,0,0,0,0,1,1,1,1,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,
  87. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,0,0,0,1,1,1,1,1,1,2,2,2,2,2,2,2,2,2,2,2,2,2,
  88. 2,2,2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,0,0,0,1,1,1,1,1,1,2,2,2,2,5,
  89. 5,5,5,5,5,5,5,2,2,2,2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,0,0,0,1,1,1,
  90. 1,1,1,2,2,2,2,2,5,5,5,5,5,5,5,5,5,2,2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,
  91. 1,1,0,0,0,1,1,1,1,1,1,2,2,2,2,2,2,5,5,5,5,5,5,5,5,5,2,0,0,0,0,0,0,0,0,0,0,0,0,0,
  92. 0,0,0,0,0,5,1,1,1,1,0,0,0,1,1,1,1,1,1,2,2,2,2,2,2,2,2,5,5,5,5,5,5,5,5,0,0,0,0,0,
  93. 0,0,0,0,0,0,0,0,0,0,0,0,5,5,1,1,1,1,0,0,0,1,1,1,1,1,1,2,2,2,2,2,2,2,2,2,5,5,5,5,
  94. 5,5,5,5,5,0,0,0,0,0,0,0,0,0,0,0,0,0,0,5,5,5,1,1,1,1,0,0,0,1,1,1,1,1,1,2,2,2,2,2,
  95. 2,2,2,2,2,5,5,5,5,5,5,5,5,5,0,0,0,0,0,0,0,0,0,0,0,0,0,5,1,1,1,1,1,1,0,0,0,1,1,1,
  96. 1,1,1,2,2,2,2,2,2,2,2,2,2,2,5,5,5,5,5,5,5,5,0,0,0,0,0,0,0,0,0,0,0,0,0,5,1,7,1,4,
  97. 4,6,6,6,6,6,6,1,1,1,1,2,2,2,2,2,2,2,2,2,2,2,5,5,5,5,5,5,5,5,0,0,0,0,0,0,0,0,0,0,
  98. 0,0,0,5,5,1,1,1,1,1,1,1,1,1,2,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,5,5,5,5,5,5,5,5,0,0,
  99. 0,0,0,0,0,0,0,0,0,0,0,5,5,1,1,1,1,1,1,1,1,1,3,3,1,1,1,1,9,9,9,9,9,9,9,9,9,9,5,5,
  100. 5,5,5,5,5,5,5,0,0,0,0,0,0,0,0,0,0,0,0,0,5,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,9,9,9,9,
  101. 9,9,9,9,9,9,5,5,5,5,5,5,5,5,5,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,
  102. 1,1,1,1,9,9,9,9,9,9,9,9,9,9,5,5,5,5,5,5,5,5,5,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,5,5,
  103. 1,7,7,1,7,1,5,0,0,0,0,0,0,0,0,0,0,0,0,0,0,5,5,5,5,5,5,5,5,5,5,0,0,0,0,0,0,0,0,0,
  104. 0,0,0,0,0,0,0,5,5,1,7,7,7,1,1,5,0,0,0,0,0,0,0,0,0,0,0,0,5,5,5,5,5,5,5,5,5,5,5,0,
  105. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,5,5,1,1,5,5,5,5,0,0,0,0,0,0,0,0,0,0,5,5,5,5,5,5,
  106. 5,5,5,5,5,5,5,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,5,5,5,0,0,0,0,0,0,0,0,0,0,0,
  107. 0,0,5,5,5,5,5,5,5,5,5,5,5,5,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  108. 0,0,0,0,0,0,0,0,0,0,5,5,5,5,5,5,5,5,5,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  109. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,5,5,5,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  110. );
  111.       frame3 : icon = (
  112. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  113. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  114. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  115. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  116. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  117. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  118. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  119. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  120. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,9,9,9,9,
  121. 9,9,9,9,9,9,9,5,5,5,5,5,5,5,0,0,0,0,0,0,0,0,0,0,0,0,0,7,7,1,1,1,1,1,1,1,1,1,1,1,
  122. 1,1,1,1,9,9,9,9,9,9,9,9,9,5,5,5,5,5,5,5,5,5,5,5,0,0,0,0,0,0,0,0,0,0,7,1,1,1,1,1,
  123. 1,1,0,0,0,1,1,1,1,1,1,1,9,9,9,9,9,9,9,5,5,5,5,5,5,5,5,5,5,5,5,5,0,0,0,0,0,0,0,0,
  124. 0,7,1,1,7,7,1,1,1,1,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,5,5,5,1,7,7,7,7,5,5,5,5,5,5,
  125. 5,0,0,0,0,0,0,0,7,1,7,7,7,1,1,1,1,1,0,0,0,1,1,1,1,1,1,2,2,2,2,2,2,5,5,1,1,1,7,7,
  126. 1,1,7,5,5,5,5,5,5,5,0,0,0,0,0,0,1,1,7,1,1,7,1,1,1,1,0,0,0,1,1,1,1,1,1,2,2,2,2,2,
  127. 2,1,7,7,7,1,7,7,7,7,7,5,5,5,5,5,5,5,5,0,0,0,0,0,1,7,7,7,7,1,1,1,1,1,0,0,0,1,1,1,
  128. 1,1,1,2,2,2,2,2,2,1,7,7,7,7,7,7,7,1,1,5,5,5,5,5,5,5,5,5,0,0,0,0,7,7,1,7,1,7,1,1,
  129. 1,1,0,0,0,1,1,1,1,1,1,2,2,2,2,2,2,2,1,1,1,1,1,1,2,2,5,5,5,5,5,5,5,5,5,5,5,0,0,0,
  130. 7,7,7,7,7,1,1,1,1,1,0,0,0,1,1,1,1,1,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,5,5,5,5,5,5,
  131. 5,5,5,5,5,0,0,0,7,7,0,0,7,7,1,1,1,1,0,0,0,1,1,1,1,1,1,2,2,2,2,2,2,2,2,2,2,2,2,2,
  132. 2,2,5,5,0,0,5,5,0,5,5,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,0,0,0,1,1,1,1,1,1,2,2,2,2,2,
  133. 2,2,2,2,2,2,2,2,2,2,2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,0,0,0,1,1,1,
  134. 1,1,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,4,
  135. 4,6,6,6,6,6,6,1,1,1,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,0,0,0,0,0,0,0,0,0,0,0,0,0,
  136. 0,0,0,0,0,0,1,1,1,1,1,1,1,1,2,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,
  137. 0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,3,3,1,1,1,1,9,9,9,9,9,9,9,9,9,9,9,9,
  138. 9,9,9,9,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,9,9,9,9,
  139. 9,9,9,9,9,9,9,9,9,9,9,9,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,
  140. 1,1,1,1,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  141. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  142. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  143. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  144. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  145. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  146. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  147. 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  148. );
  149.  
  150.  
  151. VAR Virscr : VirtPtr;                      { Our first Virtual screen }
  152.     VirScr2 : VirtPtr;                     { Our second Virtual screen }
  153.     Vaddr  : word;                      { The segment of our virtual screen}
  154.     Vaddr2 : Word;                      { The segment of our 2nd virt. screen}
  155.     ourpal : Array [0..255,1..3] of byte; { A virtual pallette }
  156.     toaster : Array [1..10] of toastinfo; { The toaster info }
  157.  
  158. {──────────────────────────────────────────────────────────────────────────}
  159. Procedure SetMCGA;  { This procedure gets you into 320x200x256 mode. }
  160. BEGIN
  161.   asm
  162.      mov        ax,0013h
  163.      int        10h
  164.   end;
  165. END;
  166.  
  167.  
  168. {──────────────────────────────────────────────────────────────────────────}
  169. Procedure SetText;  { This procedure returns you to text mode.  }
  170. BEGIN
  171.   asm
  172.      mov        ax,0003h
  173.      int        10h
  174.   end;
  175. END;
  176.  
  177. {──────────────────────────────────────────────────────────────────────────}
  178. Procedure Cls (Col : Byte; Where:word);
  179.    { This clears the screen to the specified color }
  180. BEGIN
  181.      asm
  182.         push    es
  183.         mov     cx, 32000;
  184.         mov     es,[where]
  185.         xor     di,di
  186.         mov     al,[col]
  187.         mov     ah,al
  188.         rep     stosw
  189.         pop     es
  190.      End;
  191. END;
  192.  
  193.  
  194. {──────────────────────────────────────────────────────────────────────────}
  195. Procedure Putpixel (X,Y : Integer; Col : Byte; where:word);
  196.   { This puts a pixel on the screen by writing directly to memory. }
  197. BEGIN
  198.   Asm
  199.     push    ds
  200.     push    es
  201.     mov     ax,[where]
  202.     mov     es,ax
  203.     mov     bx,[X]
  204.     mov     dx,[Y]
  205.     push    bx                      {; and this again for later}
  206.     mov     bx, dx                  {; bx = dx}
  207.     mov     dh, dl                  {; dx = dx * 256}
  208.     xor     dl, dl
  209.     shl     bx, 1
  210.     shl     bx, 1
  211.     shl     bx, 1
  212.     shl     bx, 1
  213.     shl     bx, 1
  214.     shl     bx, 1                   {; bx = bx * 64}
  215.     add     dx, bx                  {; dx = dx + bx (ie y*320)}
  216.     pop     bx                      {; get back our x}
  217.     add     bx, dx                  {; finalise location}
  218.     mov     di, bx
  219.     {; es:di = where to go}
  220.     xor     al,al
  221.     mov     ah, [Col]
  222.     mov     es:[di],ah
  223.     pop     es
  224.     pop     ds
  225.   End;
  226. END;
  227.  
  228.  
  229. {──────────────────────────────────────────────────────────────────────────}
  230. procedure WaitRetrace; assembler;
  231.   {  This waits for a vertical retrace to reduce snow on the screen }
  232. label
  233.   l1, l2;
  234. asm
  235.     mov dx,3DAh
  236. l1:
  237.     in al,dx
  238.     and al,08h
  239.     jnz l1
  240. l2:
  241.     in al,dx
  242.     and al,08h
  243.     jz  l2
  244. end;
  245.  
  246.  
  247. {──────────────────────────────────────────────────────────────────────────}
  248. Procedure Pal(Col,R,G,B : Byte);
  249.   { This sets the Red, Green and Blue values of a certain color }
  250. Begin
  251.    asm
  252.       mov    dx,3c8h
  253.       mov    al,[col]
  254.       out    dx,al
  255.       inc    dx
  256.       mov    al,[r]
  257.       out    dx,al
  258.       mov    al,[g]
  259.       out    dx,al
  260.       mov    al,[b]
  261.       out    dx,al
  262.    end;
  263. End;
  264.  
  265. {──────────────────────────────────────────────────────────────────────────}
  266. Procedure GetPal(Col : Byte; Var R,G,B : Byte);
  267.   { This gets the Red, Green and Blue values of a certain color }
  268. Var
  269.    rr,gg,bb : Byte;
  270. Begin
  271.    asm
  272.       mov    dx,3c7h
  273.       mov    al,col
  274.       out    dx,al
  275.  
  276.       add    dx,2
  277.  
  278.       in     al,dx
  279.       mov    [rr],al
  280.       in     al,dx
  281.       mov    [gg],al
  282.       in     al,dx
  283.       mov    [bb],al
  284.    end;
  285.    r := rr;
  286.    g := gg;
  287.    b := bb;
  288. end;
  289.  
  290. {──────────────────────────────────────────────────────────────────────────}
  291. Procedure SetUpVirtual;
  292.    { This sets up the memory needed for the virtual screen }
  293. BEGIN
  294.   GetMem (VirScr,64000);
  295.   vaddr := seg (virscr^);
  296.   GetMem (VirScr2,64000);
  297.   vaddr2 := seg (virscr2^);
  298. END;
  299.  
  300.  
  301. {──────────────────────────────────────────────────────────────────────────}
  302. Procedure ShutDown;
  303.    { This frees the memory used by the virtual screen }
  304. BEGIN
  305.   FreeMem (VirScr,64000);
  306.   FreeMem (VirScr2,64000);
  307. END;
  308.  
  309.  
  310. {──────────────────────────────────────────────────────────────────────────}
  311. procedure flip(source,dest:Word);
  312.   { This copies the entire screen at "source" to destination }
  313. begin
  314.   asm
  315.     push    ds
  316.     mov     ax, [Dest]
  317.     mov     es, ax
  318.     mov     ax, [Source]
  319.     mov     ds, ax
  320.     xor     si, si
  321.     xor     di, di
  322.     mov     cx, 32000
  323.     rep     movsw
  324.     pop     ds
  325.   end;
  326. end;
  327.  
  328.  
  329. {──────────────────────────────────────────────────────────────────────────}
  330. Procedure putico(X,Y:Word;VAR sprt : icon;Where:Word); ASSEMBLER;
  331.   { This puts an icon, EXCEPT it's color 0 (black) pixels, onto the screen
  332.     "where", at position X,Y }
  333. label
  334.   _Redraw, _DrawLoop, _Exit, _LineLoop, _NextLine, _Store, _NoPaint;
  335.  
  336. asm
  337.     push  ds
  338.     push  es
  339.     lds   si,Sprt
  340.     mov   ax,X     { ax = x }
  341.     mov   bx,Y     { bx = y }
  342. _Redraw:
  343.     push    ax
  344.     mov     ax,[where]
  345.     mov     es,ax
  346.  
  347.     mov     ax, bx                  {; ax = bx  x = y}
  348.     mov     bh, bl                  {; y = y * 256  bx = bx * 256}
  349.     xor     bl, bl
  350.     shl     ax, 1
  351.     shl     ax, 1
  352.     shl     ax, 1
  353.     shl     ax, 1
  354.     shl     ax, 1
  355.     shl     ax, 1                   {; y = y * 64   ax = ax * 64}
  356.     add     bx, ax                  {; y = (y*256) + (Y*64)  bx = bx + ax (ie y*320)}
  357.  
  358.     pop     ax                      {; get back our x}
  359.  
  360.  
  361.     add     ax, bx                  {; finalise location}
  362.     mov     di, ax
  363.  
  364.     mov   dl,30    { dl = height of sprite }
  365.     xor   ch,ch
  366.     mov   cl,48     { cx = width of sprite }
  367.     cld
  368.     push  ax
  369.     mov   ax,cx
  370. _DrawLoop:
  371.     push  di            { store y adr. for later }
  372.     mov   cx,ax          { store width }
  373. _LineLoop:
  374.     mov   bl,byte ptr [si]
  375.     or    bl,bl
  376.     jnz   _Store
  377. _NoPaint:
  378.     inc    si
  379.     inc    di
  380.     loop   _LineLoop
  381.     jmp    _NextLine
  382. _Store:
  383.     movsb
  384.     loop  _LineLoop
  385. _NextLine:
  386.     pop   di
  387.     dec   dl
  388.     jz    _Exit
  389.     add   di,320        { di = next line of sprite }
  390.     jmp   _DrawLoop
  391. _Exit:
  392.     pop   ax
  393.     pop   es
  394.     pop   ds
  395. end;
  396.  
  397.  
  398.  
  399.  
  400.  
  401. {──────────────────────────────────────────────────────────────────────────}
  402. Procedure Funny_line(a,b,c,d:integer;where:word);
  403.   { This procedure draws a line from a,b to c,d on screen "where". After
  404.     each pixel it plots, it increments a color counter for the next pixel.
  405.     you may easily alter this to be a normal line procedure, and it will
  406.     be quite a bit faster than the origional one I gave you. This is
  407.     because I replaced all the reals with integers. }
  408.  
  409.   function sgn(a:real):integer;
  410.   begin
  411.        if a>0 then sgn:=+1;
  412.        if a<0 then sgn:=-1;
  413.        if a=0 then sgn:=0;
  414.   end;
  415. var i,s,d1x,d1y,d2x,d2y,u,v,m,n:integer;
  416.     count:integer;
  417. begin
  418.      count:=50;
  419.      u:= c - a;
  420.      v:= d - b;
  421.      d1x:= SGN(u);
  422.      d1y:= SGN(v);
  423.      d2x:= SGN(u);
  424.      d2y:= 0;
  425.      m:= ABS(u);
  426.      n := ABS(v);
  427.      IF NOT (M>N) then
  428.      BEGIN
  429.           d2x := 0 ;
  430.           d2y := SGN(v);
  431.           m := ABS(v);
  432.           n := ABS(u);
  433.      END;
  434.      s := m shr 1;
  435.      FOR i := 0 TO m DO
  436.      BEGIN
  437.           putpixel(a,b,count,where);
  438.           inc (count);
  439.           if count=101 then count:=50;
  440.           s := s + n;
  441.           IF not (s<m) THEN
  442.           BEGIN
  443.                s := s - m;
  444.                a:= a + d1x;
  445.                b := b + d1y;
  446.           END
  447.           ELSE
  448.           BEGIN
  449.                a := a + d2x;
  450.                b := b + d2y;
  451.           END;
  452.      end;
  453. END;
  454.  
  455.  
  456.  
  457. {──────────────────────────────────────────────────────────────────────────}
  458. Procedure SetUpScreen;
  459.   { This procedure sets up the static background to be used in the program }
  460.  
  461. CONST circ : Array [1..5,1..5] of byte =
  462.         ((0,10,10,10,0),
  463.          (10,13,12,11,10),
  464.          (10,12,12,11,10),
  465.          (10,11,11,11,10),
  466.          (0,10,10,10,0));
  467.  
  468. VAR x,y:integer;
  469.     loop1,loop2,loop3:integer;
  470.  
  471. BEGIN
  472.   pal (1,22,22,22);
  473.   pal (2,45,45,45);
  474.   pal (3,59,59,59);
  475.   pal (4,63,63,27);
  476.   pal (5,39,63,3);
  477.   pal (6,51,39,3);
  478.   pal (7,3,27,3);
  479.   pal (8,15,39,15);
  480.   pal (9,35,35,35);
  481.   pal (10, 0, 0,40);
  482.   pal (11,10,10,50);
  483.   pal (12,20,20,60);
  484.   pal (13,30,30,63);
  485.  
  486.   For loop1:=50 to 100 do
  487.     pal (loop1,0,0,loop1-36);
  488.  
  489.   For loop1:=0 to 255 do
  490.      getpal (loop1,OurPal[loop1,1],OurPal[loop1,2],OurPal[loop1,3]);
  491.  
  492.   For loop1:=0 to 319 do
  493.     Funny_line (0,199,loop1,0,vaddr);
  494.   For loop1:=0 to 199 do
  495.     Funny_line (0,199,319,loop1,vaddr);
  496.  
  497.   For loop1:=1 to 200 do BEGIN
  498.     x:=random (315);
  499.     y:=random (195);
  500.     For loop2:=1 to 5 do
  501.       For loop3:=1 to 5 do
  502.         if circ [loop2,loop3]<>0 then
  503.           putpixel (x+loop2,y+loop3,circ [loop2,loop3],vaddr);
  504.   END;
  505.   flip (vaddr,vga);  { Copy the entire screen at vaddr, our virtual screen }
  506.                      { on which we have done all our graphics, onto the    }
  507.                      { screen you see, VGA }
  508.   flip (vaddr,vaddr2);
  509. END;
  510.  
  511.  
  512. {──────────────────────────────────────────────────────────────────────────}
  513. Procedure rotatepal;
  514.   { This procedure rotates the colors between 50 and 100 }
  515. VAR temp : Array [1..3] of byte;
  516.     loop1:integer;
  517. BEGIN
  518.   Move(OurPal[100],Temp,3);
  519.   Move(OurPal[50],OurPal[51],50*3);
  520.   Move(Temp,OurPal[50],3);
  521.   For loop1:=50 to 100 do
  522.     pal (loop1,OurPal[loop1,1],OurPal[loop1,2],OurPal[loop1,3]);
  523. END;
  524.  
  525.  
  526. {──────────────────────────────────────────────────────────────────────────}
  527. Procedure ScreenTrans (x,y:word);
  528.   { This is a small procedure to copy a 30x30 pixel block from coordinates
  529.     x,y on the virtual screen to coordinates x,y on the true vga screen }
  530. BEGIN
  531.   asm
  532.     push    ds
  533.     push    es
  534.     mov     ax,vaddr
  535.     mov     es,ax
  536.     mov     ax,vaddr2
  537.     mov     ds,ax
  538.     mov     bx,[X]
  539.     mov     dx,[Y]
  540.     push    bx                      {; and this again for later}
  541.     mov     bx, dx                  {; bx = dx}
  542.     mov     dh, dl                  {; dx = dx * 256}
  543.     xor     dl, dl
  544.     shl     bx, 1
  545.     shl     bx, 1
  546.     shl     bx, 1
  547.     shl     bx, 1
  548.     shl     bx, 1
  549.     shl     bx, 1                   {; bx = bx * 64}
  550.     add     dx, bx                  {; dx = dx + bx (ie y*320)}
  551.     pop     bx                      {; get back our x}
  552.     add     bx, dx                  {; finalise location}
  553.     mov     di, bx                  {; es:di = where to go}
  554.     mov     si, di
  555.     mov     al,60
  556.     mov     bx, 30         { Hight of block to copy }
  557. @@1 :
  558.     mov     cx, 24         { Width of block to copy divided by 2 }
  559.     rep     movsw
  560.     add     di,110h        { 320 - 48 = 272 .. or 110 in hex }
  561.     add     si,110h
  562.     dec     bx
  563.     jnz     @@1
  564.  
  565.     pop     es
  566.     pop     ds
  567.   end;
  568.   { I wrote this procedure late last night, so it may not be in it's
  569.     most optimised state. Sorry :-)}
  570. END;
  571.  
  572.  
  573. {──────────────────────────────────────────────────────────────────────────}
  574. Procedure NewToaster;
  575.   { This adds a new toaster to the screen }
  576. VAR loop1:integer;
  577. BEGIN
  578.   loop1:=0;
  579.   repeat
  580.     inc (loop1);
  581.     if not (toaster[loop1].active) then BEGIN
  582.       toaster[loop1].x:=random (200)+70;
  583.       toaster[loop1].y:=0;
  584.       toaster[loop1].active:=true;
  585.       toaster[loop1].frame:=1;
  586.       toaster[loop1].speed:=Random (3)+1;
  587.       loop1:=10;
  588.     END;
  589.   until loop1=10;
  590. END;
  591.  
  592.  
  593. {──────────────────────────────────────────────────────────────────────────}
  594. Procedure Fly;
  595.   { This is the procedure where we move and put the toasters }
  596. VAR loop1,loop2:integer;
  597.     ch:char;
  598. BEGIN
  599.   For loop1:=1 to 10 do
  600.     toaster[loop1].active:=FALSE;
  601.   ch:=#0;
  602.   NewToaster;
  603.   Repeat
  604.     if keypressed then BEGIN
  605.       ch:=readkey;
  606.       if ch='+' then NewToaster;      { If '+' is pressed, add a toaster }
  607.       if ch='-' then BEGIN            { if '-' is pressed, remove a toaster }
  608.         loop1:=0;
  609.         repeat
  610.           inc (loop1);
  611.           if toaster[loop1].active then BEGIN
  612.             screentrans (toaster[loop1].x,toaster[loop1].y);
  613.             toaster [loop1].active:=FALSE;
  614.             loop1:=10;
  615.           END;
  616.         until loop1=10;
  617.       END;
  618.     END;
  619.     for loop1:=1 to 10 do
  620.       if toaster[loop1].active then BEGIN
  621.         screentrans (toaster[loop1].x,toaster[loop1].y);
  622.           { Restore the backgrond the toaster was over }
  623.         dec (toaster[loop1].x,toaster[loop1].speed);
  624.         inc (toaster[loop1].y,toaster[loop1].speed);
  625.           { Move the toaster }
  626.         if (toaster[loop1].x<1) or (toaster[loop1].y>170) then BEGIN
  627.           toaster[loop1].active:=FALSE;
  628.           NewToaster;
  629.         END;
  630.           { When toaster reaches the edge of the screen, render it inactive
  631.             and bring a new one into existance. }
  632.       END;
  633.     for loop1:=1 to 10 do
  634.       if toaster[loop1].active then BEGIN
  635.         CASE toaster [loop1].frame of
  636.            1   : putico (toaster[loop1].x,toaster[loop1].y,frame1,vaddr);
  637.            3   : putico (toaster[loop1].x,toaster[loop1].y,frame2,vaddr);
  638.            2,4 : putico (toaster[loop1].x,toaster[loop1].y,frame3,vaddr);
  639.         END;
  640.         toaster[loop1].frame:=toaster[loop1].frame+1;
  641.         if toaster [loop1].frame=5 then toaster[loop1].frame:=1;
  642.           { Draw all the toasters on the VGA screen }
  643.       END;
  644.     waitretrace;
  645.     flip (vaddr,vga);
  646.     rotatepal;
  647.   Until ch=#27;
  648. END;
  649.  
  650.  
  651. BEGIN
  652.   Randomize;       { Make sure that the RANDOM funcion really is random }
  653.   SetupVirtual;    { Set up virtual page, VADDR }
  654.   ClrScr;
  655.   writeln ('Hello! This program will demonstrate the principals of animation.');
  656.   writeln ('The program will firstly generate an arb background screen to a');
  657.   writeln ('virtual page, then flip it to the VGA. A toaster will then start');
  658.   writeln ('to move across the screen. Note that the background will be restored');
  659.   writeln ('after the toaster has passed over it. You may add or remove toasters');
  660.   writeln ('by hitting "+" or "-" respectively. Note that the more frames you');
  661.   writeln ('use, usually the better the routine looks. Because of space');
  662.   writeln ('restrictions, we only had room for three frames.');
  663.   writeln;
  664.   writeln ('The toasters were drawn by Fubar (Pieter Buys) in Autodesk Animator.');
  665.   writeln ('I wrote a small little program to convert them into CONSTANTS. See');
  666.   writeln ('the main text to find out how to load up AA CEL files directly.');
  667.   writeln;
  668.   writeln;
  669.   Write ('  Hit any key to contine ...');
  670.   Readkey;
  671.   SetMCGA;
  672.   SetupScreen;     { Draw the background screen to VADDR, then flip it to
  673.                      the VGA screen }
  674.   Fly;             { Make the toasters fly around the screen }
  675.   SetText;
  676.   ShutDown;        { Free the memory taken up by virtual page }
  677.   Writeln ('All done. This concludes the seventh sample program in the ASPHYXIA');
  678.   Writeln ('Training series. You may reach DENTHOR under the names of GRANT');
  679.   Writeln ('SMITH/DENTHOR/ASPHYXIA on the ASPHYXIA BBS. I am also an avid');
  680.   Writeln ('Connectix BBS user, which is unfortunatly offline for the moment.');
  681.   Writeln ('For discussion purposes, I am also the moderator of the Programming');
  682.   Writeln ('newsgroup on the For Your Eyes Only BBS.');
  683.   Writeln ('The numbers are available in the main text. You may also write to me at:');
  684.   Writeln ('             Grant Smith');
  685.   Writeln ('             P.O. Box 270');
  686.   Writeln ('             Kloof');
  687.   Writeln ('             3640');
  688.   Writeln ('I hope to hear from you soon!');
  689.   Writeln; Writeln;
  690.   Write   ('Hit any key to exit ...');
  691.   Readkey;
  692. END.
  693.